home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 7: Sunsite / Linux Cubed Series 7 - Sunsite Vol 1.iso / system / shells / scsh-0.4 / scsh-0 / scsh-0.4.2 / scsh / syscalls1.c < prev    next >
C/C++ Source or Header  |  1995-11-01  |  12KB  |  528 lines
  1. /* Scheme48/scsh Unix system interface.
  2. ** Routines that require custom C support.
  3. ** Copyright (c) 1993,1994 by Olin Shivers.
  4. */
  5.  
  6. #include "sysdep.h"
  7. #include <stdio.h>
  8. #include <stdlib.h>
  9. #include <sys/signal.h>
  10. #include <sys/types.h>
  11. #include <sys/times.h>
  12. #include <sys/time.h>
  13. #include <fcntl.h>        /* for O_RDWR */
  14. #include <sys/stat.h>
  15. #include <netdb.h>
  16. #include <pwd.h>
  17. #include <sys/param.h> /* For gethostname() */
  18. #include <errno.h>
  19. #include <sys/wait.h>
  20. #include <unistd.h>
  21. #include <string.h>
  22. #include <utime.h>
  23.  
  24. #include "cstuff.h"
  25. #include "machine/stdio_dep.h"
  26.  
  27. /* Make sure our exports match up w/the implementation: */
  28. #include "syscalls1.h"
  29.  
  30. extern int errno;
  31. extern char **environ;
  32.  
  33. /* Sux because it's dependent on 32-bitness. */
  34. #define hi8(i)  (((i)>>24) & 0xff)
  35. #define lo24(i) ((i) & 0xffffff)
  36. #define comp8_24(hi, lo) (((hi)<<24) + (lo))
  37.  
  38.  
  39. /* Process stuff
  40. *******************************************************************************
  41. ** wait, exec
  42. */
  43.  
  44. /* Args: pid, flags; returns [retval, status] */
  45.  
  46. scheme_value wait_pid(int pid, int flags, int *result_pid, int *status)
  47. {
  48.     *result_pid = waitpid(pid, status, flags);
  49.     return (*result_pid == -1) ? ENTER_FIXNUM(errno) : SCHFALSE;
  50.     }
  51.  
  52.  
  53. /* env:  Scheme vector of Scheme strings, e.g., #("TERM=vt100" ...) or #T.
  54. ** argv: Scheme vector of Scheme strings.
  55. ** prog: String.
  56. ** 
  57. ** We don't typecheck the args. You must do the typechecking
  58. ** on the Scheme side.
  59. */
  60.  
  61. int scheme_exec(const char *prog, scheme_value argv, scheme_value env)
  62. {
  63.   int i, j, e;
  64.   int argc = VECTOR_LENGTH(argv);
  65.  
  66.   char **unix_argv = Malloc(char*, argc+1);
  67.   char **unix_env;
  68.  
  69.   if( unix_argv == NULL ) return errno;
  70.  
  71.   /* Scheme->Unix convert the argv parameter. */
  72.   for(i=0; i<argc; i++)
  73.     unix_argv[i] = cig_string_body(VECTOR_REF(argv,i));
  74.   unix_argv[argc] = NULL;
  75.  
  76.   /* Scheme->Unix convert the env parameter. */
  77.   if( env == SCHTRUE ) unix_env = environ;
  78.   else {
  79.     int envlen = VECTOR_LENGTH(env);
  80.     unix_env = Malloc(char*, envlen+1);
  81.  
  82.     if( !unix_env ) goto lose;
  83.  
  84.     for(j=0; j<envlen; j++)
  85.       unix_env[j] = cig_string_body(VECTOR_REF(env,j));
  86.     unix_env[envlen] = NULL;
  87.   }
  88.  
  89.   execve(prog, unix_argv, unix_env); /* Do it. */
  90.  
  91.   if( env != SCHTRUE ) {
  92.     e = errno;
  93.     Free(unix_env);
  94.     errno = e;
  95.   }
  96.  lose:
  97.   e = errno;
  98.   Free(unix_argv);
  99.   return e;
  100. }
  101.  
  102.  
  103. /* Random file and I/O stuff
  104. *******************************************************************************
  105. */
  106.  
  107. /* Returns [errno, r, w] */
  108. int scheme_pipe(int *r, int *w)
  109. {
  110.   int fds[2];
  111.   if( pipe(fds) ) {
  112.     *r = 0; *w = 0;
  113.     return errno;
  114.   }
  115.  
  116.   *r = fds[0]; *w = fds[1];
  117.   return 0;
  118. }
  119.  
  120.  
  121. /* Read the symlink into static memory. Return NULL on error. */
  122.  
  123. static char linkpath[MAXPATHLEN+1]; /*  Maybe unaligned. Not reentrant. */
  124.  
  125. char const *scm_readlink(const char *path)
  126. {
  127.   int retval = readlink(path, linkpath, MAXPATHLEN);
  128.  
  129.   return (char const *)
  130.       (retval == -1) ? NULL : ( linkpath[retval] = '\0', linkpath );
  131. }
  132.  
  133.  
  134.  
  135. /* Scheme interfaces to utime(). 
  136. ** Complicated by need to pass real 32-bit quantities.
  137. */
  138.  
  139. int scm_utime(char const *path, int ac_hi, int ac_lo, int mod_hi, int mod_lo)
  140. {
  141.     struct utimbuf t;
  142.     t.actime = comp8_24(ac_hi, ac_lo);
  143.     t.modtime = comp8_24(mod_hi, mod_lo);
  144.     return utime(path, &t);
  145.     }
  146.  
  147. int scm_utime_now(char const *path) {return utime(path, 0);}
  148.  
  149.  
  150. /* Two versions of CWD
  151. *******************************************************************************
  152. */
  153.  
  154. /* Simple-minded POSIX version. */
  155. int scheme_cwd(const char **dirp)
  156. {
  157.   char *buf;
  158.   int size = 100;
  159.  
  160.   buf = Malloc(char,size);
  161.   if(!buf) goto lose;
  162.  
  163.   while( !getcwd(buf, size) )
  164.     if( errno != ERANGE ) goto lose;
  165.     else {
  166.       /* Double the buf and retry. */
  167.       char *nbuf = Realloc(char, buf, size += size);
  168.       if( !nbuf ) goto lose;
  169.       buf = nbuf;
  170.     }
  171.  
  172.   *dirp = (const char*) buf;        /* win */
  173.   return 0;
  174.  
  175.  lose:
  176.   {int e = errno;
  177.    Free(buf);
  178.    *dirp = NULL;
  179.    return e;}
  180. }
  181.  
  182.  
  183. #if 0
  184. /* Faster SUNOS version. */
  185. /* We have to use malloc, because the stub is going to free the string. */
  186.  
  187. int scheme_cwd(const char **dirp)
  188. {
  189.   char *buf = Malloc(char,MAXPATHLEN); 
  190.   int e;
  191.  
  192.   if( buf && getwd(buf) ) {
  193.     *dirp = (const char*) buf;
  194.     return 0;
  195.   }
  196.  
  197.   /* lose */
  198.   e = errno;
  199.   Free(buf);
  200.   *dirp = NULL;
  201.   return e;
  202. }
  203. #endif
  204.  
  205.  
  206. /* Process times
  207. *******************************************************************************
  208. */
  209.  
  210. /* Sleazing on the types here -- the ret values should be clock_t, not int,
  211. ** but cig can't handle it.
  212. */
  213.  
  214. int process_times(int *utime, int *stime, int *cutime, int *cstime)
  215. {
  216.     struct tms tms;
  217.     clock_t t = times(&tms);
  218.     if (t == -1) return -1;
  219.     *utime = tms.tms_utime;
  220.     *stime = tms.tms_stime;
  221.     *cutime = tms.tms_cutime;
  222.     *cstime = tms.tms_cstime;
  223.     return t;
  224.     }
  225.  
  226. int cpu_clock_ticks_per_sec() 
  227. {
  228. #ifdef _SC_CLK_TCK
  229.   static long clock_tick = 0;
  230.     
  231.   if (clock_tick == 0)
  232.     clock_tick = sysconf(_SC_CLK_TCK); /* POSIX.1, POSIX.2 */
  233.   return clock_tick;
  234. #else
  235. #ifdef CLK_TCK
  236.   return CLK_TCK;
  237. #else
  238.   return 60;
  239. #endif
  240. #endif    
  241. }
  242.  
  243. /* Reading and writing
  244. *******************************************************************************
  245. */
  246.  
  247. /* Return a char, #f (EOF), or errno. */
  248. scheme_value read_fdes_char(int fd)
  249. {
  250.   int i; char c;
  251.   if( (i=read(fd, &c, 1)) < 0 ) return ENTER_FIXNUM(errno);
  252.   if(i==0) return SCHFALSE;
  253.   return ENTER_CHAR(c);
  254. }
  255.  
  256. int write_fdes_char(char c, int fd)  {return write(fd, &c, 1);}
  257.  
  258.  
  259. int read_fdes_substring(scheme_value buf, int start, int end, int fd)
  260. {
  261.   return read(fd, StrByte(buf,start), end-start);
  262. }
  263.  
  264. #define Min(a,b) (((a) < (b)) ? (a) : (b))    /* Not a function. */
  265.  
  266. /* Note the clearerr() call. This is so a ^D on a tty input stream
  267. ** doesn't shut the stream down forever. SunOS doesn't handle this according
  268. ** to POSIX spec, so we have to explicitly hack this case.
  269. */
  270.  
  271. int read_stream_substring(scheme_value buf, int start, int end, FILE *f)
  272. {
  273.   char *p = StrByte(buf,start);
  274.   int len = end-start;
  275.  
  276.   clearerr(f);
  277.  
  278.   /* If there's data in the buffer, use it. */
  279.  
  280.   if (fbufcount(f) > 0)
  281.     return fread(p, 1, Min(len, fbufcount(f)), f);
  282.  
  283.   /* Otherwise, do a read. */
  284.   return read(fileno(f), p, len);
  285. }
  286.  
  287.  
  288. int write_fdes_substring(scheme_value buf, int start, int end, int fd)
  289. {
  290.   return write(fd, StrByte(buf,start), end-start);
  291. }
  292.  
  293. /* We assume either fileno(f) does blocking i/o or f is unbuffered. */
  294.  
  295. int write_stream_substring(scheme_value buf, int start, int end, FILE *f)
  296. {
  297.   int retval = fwrite(StrByte(buf,start), 1, end-start, f);
  298.   return ferror(f) ? -1 : retval; /* -1: error, 0: eof */
  299. }
  300.  
  301.  
  302. /*
  303. ** Stat hackery
  304. *******************************************************************************
  305. ** DANGER, WILL ROBINSON: It's not necessarily true that all these 
  306. ** stat fields will fit into a fixnum.
  307. ** In fact, S48's 30 bit fixnums are almost certainly good enough
  308. ** for everything but times. 30 signed bits ran out in 1987.
  309. ** So the time fields are split, low 24, high everything else.
  310. ** I haven't bothered w/anything else, since the only other real limit
  311. ** is size -- files can't be bigger than .5Gb. 
  312. */
  313.  
  314. /* S_ISSOCK(mode) and S_ISLNK(mode) are not POSIX. You lose on a NeXT. Ugh. */
  315. #ifndef S_ISSOCK
  316. #define S_ISSOCK(mode) (((mode) & S_IFMT) == S_IFSOCK)
  317. #endif
  318. #ifndef S_ISLNK
  319. #define S_ISLNK(mode) (((mode) & S_IFMT) == S_IFLNK)
  320. #endif
  321.  
  322. #define low24(x) ((x) & 0xffffff)
  323. #define hi_but24(x) (((x) >> 24) & 0xff)
  324.  
  325. /* Note that hi_but24 assumes value is a *32 bit* signed value. We have to
  326. ** do this, because C's right-shift operator exposes word width. A suckful
  327. ** language.
  328. */
  329.  
  330. /* Internal aux function -- loads stat values into Scheme vector: */
  331. static int really_stat(int retval, struct stat *s, scheme_value vec)
  332. {
  333.   int modes, typecode = -1;
  334.  
  335.   if( 14 != VECTOR_LENGTH(vec) ) return -1;
  336.   if( retval < 0 ) return errno;
  337.  
  338.   modes = s->st_mode;
  339.   if( S_ISBLK(modes) )       typecode = 0;
  340.   else if( S_ISCHR(modes) )  typecode = 1;
  341.   else if( S_ISDIR(modes) )  typecode = 2;
  342.   else if( S_ISFIFO(modes) ) typecode = 3;
  343.   else if( S_ISREG(modes) )  typecode = 4;
  344.   else if( S_ISSOCK(modes) ) typecode = 5;
  345.   else if( S_ISLNK(modes) )  typecode = 6;
  346.     
  347.   VECTOR_REF(vec,0)  = ENTER_FIXNUM(typecode);
  348.   VECTOR_REF(vec,1)  = ENTER_FIXNUM(s->st_dev);
  349.   VECTOR_REF(vec,2)  = ENTER_FIXNUM(s->st_ino);
  350.   VECTOR_REF(vec,3)  = ENTER_FIXNUM(s->st_mode);
  351.   VECTOR_REF(vec,4)  = ENTER_FIXNUM(s->st_nlink);
  352.   VECTOR_REF(vec,5)  = ENTER_FIXNUM(s->st_uid);
  353.   VECTOR_REF(vec,6)  = ENTER_FIXNUM(s->st_gid);
  354.   VECTOR_REF(vec,7)  = ENTER_FIXNUM(s->st_size);
  355.  
  356.   VECTOR_REF(vec,8)  = ENTER_FIXNUM(   low24(s->st_atime));
  357.   VECTOR_REF(vec,9)  = ENTER_FIXNUM(hi_but24(s->st_atime));
  358.  
  359.   VECTOR_REF(vec,10) = ENTER_FIXNUM(   low24(s->st_mtime));
  360.   VECTOR_REF(vec,11) = ENTER_FIXNUM(hi_but24(s->st_mtime));
  361.  
  362.   VECTOR_REF(vec,12) = ENTER_FIXNUM(   low24(s->st_ctime));
  363.   VECTOR_REF(vec,13) = ENTER_FIXNUM(hi_but24(s->st_ctime));
  364.  
  365.   /* We also used to do st_rdev, st_blksize, and st_blocks.
  366.      These aren't POSIX, and, e.g., are not around on SGI machines.
  367.      Too bad -- blksize is useful. Unix sux. */
  368.  
  369.   return 0;
  370. }
  371.  
  372. int scheme_stat(const char *path, scheme_value vec, int chase_p)
  373. {
  374.   struct stat s;
  375.   return really_stat(chase_p ? stat(path, &s) : lstat(path, &s), &s, vec);
  376. }
  377.  
  378. int scheme_fstat(int fd, scheme_value vec)
  379. {
  380.   struct stat s;
  381.   return really_stat(fstat(fd,&s), &s, vec);
  382. }
  383.  
  384.  
  385. /* Supplementary groups access
  386. *******************************************************************************
  387. */
  388.  
  389. int num_supp_groups(void)
  390. {
  391.   return getgroups(0,NULL);
  392. }
  393.  
  394. /* Load the supplementary groups into GVEC. */
  395.  
  396. int get_groups(scheme_value gvec)
  397. {
  398.   int veclen = VECTOR_LENGTH(gvec), i, retval;
  399.   gid_t gvec0[20], *gp = gvec0;
  400.  
  401.   if( veclen > 20 )
  402.     if( NULL == (gp=Malloc(gid_t,veclen)) ) return -1;
  403.  
  404.   retval = getgroups(veclen, gp);
  405.     
  406.   if( retval != -1 )
  407.     for( i=veclen; i--; )
  408.       VECTOR_REF(gvec,i) = ENTER_FIXNUM(gp[i]);
  409.  
  410.   if( veclen > 20 ) Free(gp);
  411.  
  412.   return retval;
  413. }
  414.     
  415.  
  416. /* Environment hackery
  417. *******************************************************************************
  418. */
  419.  
  420. int put_env(const char *s)
  421. {
  422.   char *s1 = Malloc(char, strlen(s)+1);
  423.   if( !s1 ) return ENTER_FIXNUM(errno);
  424.     
  425.   strcpy(s1, s);
  426.  
  427.   return putenv(s1) ? ENTER_FIXNUM(errno) : SCHFALSE;
  428. }
  429.  
  430. char** scm_envvec(int *len)    /* Returns environ c-vector & its length. */
  431. {
  432.   char **ptr=environ;
  433.   while( *ptr ) ptr++;
  434.   *len = ptr-environ;
  435.  
  436.   return(environ);
  437. }
  438.  
  439. /* Load the (Scheme) strings in the (Scheme) vector VEC into environ.
  440. ** Somewhat wasteful of memory: we do not free any of the memory
  441. ** in the old environ -- don't know if it is being shared elsewhere.
  442. */
  443.  
  444. int install_env(scheme_value vec)
  445. {
  446.   int i, envsize;
  447.   char **newenv;
  448.  
  449.   envsize = VECTOR_LENGTH(vec);
  450.   newenv = Malloc(char*, envsize+1);
  451.   if( !newenv ) return errno;
  452.  
  453.   for( i=0; i<envsize; i++ ) {
  454.     char *s = scheme2c_strcpy(VECTOR_REF(vec,i));
  455.     if (!s) {
  456.       /* Return all the memory and bail out. */
  457.       int e = errno;
  458.       while(--i) Free(newenv[i]);
  459.       Free(newenv);
  460.       return e;
  461.     }
  462.     newenv[i] = s;
  463.   }
  464.  
  465.   newenv[i] = NULL;
  466.   environ = newenv;
  467.   return 0;
  468. }
  469.  
  470.  
  471. /* Delete the env var. */
  472. void delete_env(const char *var)
  473. {
  474.   int varlen = strlen(var);
  475.   char **ptr = environ-1;
  476.  
  477.   do if( !*++ptr ) return;
  478.   while( strncmp(*ptr, var, varlen) || (*ptr)[varlen] != '=' );
  479.  
  480.   do ptr[0] = ptr[1]; while( *++ptr ); 
  481. }    
  482.  
  483.  
  484. /*****************************************************************************/
  485.  
  486. /* N.B.: May be unaligned. 
  487. ** Not re-entrant, either -- will puke if multithreaded.
  488. */
  489. static char hostname[MAXHOSTNAMELEN+1]; 
  490.  
  491. char *scm_gethostname(void)
  492. {
  493.     /* different OS's declare differently, so punt the prototype. */
  494.     int gethostname(); 
  495.     gethostname(hostname, MAXHOSTNAMELEN);
  496.     return hostname;
  497. }
  498.  
  499. #include <errno.h>
  500.  
  501. char *errno_msg(int i)
  502. {
  503. #ifdef HAVE_STRERROR
  504.     return(strerror(i));
  505. #else
  506.     /* temp hack until we figure out what to do about losing sys_errlist's */
  507.     extern
  508. #ifdef HAVE_CONST_SYS_ERRLIST
  509.     const
  510. #endif
  511.         char *sys_errlist[]; 
  512.     extern int sys_nerr;
  513.     return ( i < 0 || i > sys_nerr ) ? NULL /* i.e., #f */
  514.     : (char*) sys_errlist[i];
  515. #endif /* !HAVE_STRERROR */
  516. }
  517.  
  518. /* Some of fcntl()
  519. ******************
  520. */
  521.  
  522. int fcntl_read(int fd, int command)
  523. { return fcntl(fd, command); }
  524.  
  525.  
  526. int fcntl_write(int fd, int command, int value)
  527. { return fcntl(fd, command, value); }
  528.